home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / harvest.cpt / Harvest C / Tcl 6.2 / tclUnixUtil.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-04-13  |  27.6 KB  |  1,044 lines
  1. #ifdef macintosh
  2. #    pragma segment tclUnixUtil
  3. #endif
  4.  
  5. /* 
  6.  * tclUnixUtil.c --
  7.  *
  8.  *    This file contains a collection of utility procedures that
  9.  *    are present in the Tcl's UNIX core but not in the generic
  10.  *    core.  For example, they do file manipulation and process
  11.  *    manipulation.
  12.  *
  13.  *    The Tcl_Fork and Tcl_WaitPids procedures are based on code
  14.  *    contributed by Karl Lehenbauer, Mark Diekhans and Peter
  15.  *    da Silva.
  16.  *
  17.  * Copyright 1991 Regents of the University of California
  18.  * Permission to use, copy, modify, and distribute this
  19.  * software and its documentation for any purpose and without
  20.  * fee is hereby granted, provided that this copyright
  21.  * notice appears in all copies.  The University of California
  22.  * makes no representations about the suitability of this
  23.  * software for any purpose.  It is provided "as is" without
  24.  * express or implied warranty.
  25.  */
  26.  
  27. #ifndef lint
  28. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclUnixUtil.c,v 1.18 91/11/21 14:53:46 ouster Exp $ SPRITE (Berkeley)";
  29. #endif /* not lint */
  30.  
  31. #include "tclInt.h"
  32. #include "tclUnix.h"
  33.  
  34. /*
  35.  * Data structures of the following type are used by Tcl_Fork and
  36.  * Tcl_WaitPids to keep track of child processes.
  37.  */
  38.  
  39. #ifndef macintosh
  40. typedef struct {
  41.     int pid;            /* Process id of child. */
  42.     WAIT_STATUS_TYPE status;    /* Status returned when child exited or
  43.                  * suspended. */
  44.     int flags;            /* Various flag bits;  see below for
  45.                  * definitions. */
  46. } WaitInfo;
  47. #endif
  48.  
  49. /*
  50.  * Flag bits in WaitInfo structures:
  51.  *
  52.  * WI_READY -            Non-zero means process has exited or
  53.  *                suspended since it was forked or last
  54.  *                returned by Tcl_WaitPids.
  55.  * WI_DETACHED -        Non-zero means no-one cares about the
  56.  *                process anymore.  Ignore it until it
  57.  *                exits, then forget about it.
  58.  */
  59.  
  60. #define WI_READY    1
  61. #define WI_DETACHED    2
  62.  
  63. #ifndef macintosh
  64. static WaitInfo *waitTable = NULL;
  65. static int waitTableSize = 0;    /* Total number of entries available in
  66.                  * waitTable. */
  67. static int waitTableUsed = 0;    /* Number of entries in waitTable that
  68.                  * are actually in use right now.  Active
  69.                  * entries are always at the beginning
  70.                  * of the table. */
  71. #define WAIT_TABLE_GROW_BY 4
  72. #endif
  73.  
  74.  
  75. /*
  76.  *----------------------------------------------------------------------
  77.  *
  78.  * Tcl_EvalFile --
  79.  *
  80.  *    Read in a file and process the entire file as one gigantic
  81.  *    Tcl command.
  82.  *
  83.  * Results:
  84.  *    A standard Tcl result, which is either the result of executing
  85.  *    the file or an error indicating why the file couldn't be read.
  86.  *
  87.  * Side effects:
  88.  *    Depends on the commands in the file.
  89.  *
  90.  *----------------------------------------------------------------------
  91.  */
  92.  
  93. int
  94. Tcl_EvalFile(interp, fileName)
  95.     Tcl_Interp *interp;        /* Interpreter in which to process file. */
  96.     char *fileName;        /* Name of file to process.  Tilde-substitution
  97.                  * will be performed on this name. */
  98. {
  99.     int fileId, result;
  100.     struct stat statBuf;
  101.     char *cmdBuffer, *end, *oldScriptFile;
  102.     Interp *iPtr = (Interp *) interp;
  103.  
  104.     oldScriptFile = iPtr->scriptFile;
  105.     iPtr->scriptFile = fileName;
  106.     fileName = Tcl_TildeSubst(interp, fileName);
  107.     if (fileName == NULL) {
  108.     goto error;
  109.     }
  110.     fileId = open(fileName, O_RDONLY, 0);
  111.     if (fileId < 0) {
  112.     Tcl_AppendResult(interp, "couldn't read file \"", fileName,
  113.         "\": ", Tcl_UnixError(interp), (char *) NULL);
  114.     goto error;
  115.     }
  116.     if (fstat(fileId, &statBuf) == -1) {
  117.     Tcl_AppendResult(interp, "couldn't stat file \"", fileName,
  118.         "\": ", Tcl_UnixError(interp), (char *) NULL);
  119.     close(fileId);
  120.     goto error;
  121.     }
  122.     cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
  123.     if (read(fileId, cmdBuffer, (int) statBuf.st_size) != statBuf.st_size) {
  124.     Tcl_AppendResult(interp, "error in reading file \"", fileName,
  125.         "\": ", Tcl_UnixError(interp), (char *) NULL);
  126.     close(fileId);
  127.     goto error;
  128.     }
  129.     if (close(fileId) != 0) {
  130.     Tcl_AppendResult(interp, "error closing file \"", fileName,
  131.         "\": ", Tcl_UnixError(interp), (char *) NULL);
  132.     goto error;
  133.     }
  134.     cmdBuffer[statBuf.st_size] = 0;
  135.     result = Tcl_Eval(interp, cmdBuffer, 0, &end);
  136.     if (result == TCL_RETURN) {
  137.     result = TCL_OK;
  138.     }
  139.     if (result == TCL_ERROR) {
  140.     char msg[200];
  141.  
  142.     /*
  143.      * Record information telling where the error occurred.
  144.      */
  145.  
  146.     sprintf(msg, "\n    (file \"%.150s\" line %d)", fileName,
  147.         interp->errorLine);
  148.     Tcl_AddErrorInfo(interp, msg);
  149.     }
  150.     ckfree(cmdBuffer);
  151.     iPtr->scriptFile = oldScriptFile;
  152.     return result;
  153.  
  154.     error:
  155.     iPtr->scriptFile = oldScriptFile;
  156.     return TCL_ERROR;
  157. }
  158.  
  159. /*
  160.  *----------------------------------------------------------------------
  161.  *
  162.  * Tcl_Fork --
  163.  *
  164.  *    Create a _new process using the vfork system call, and keep
  165.  *    track of it for "safe" waiting with Tcl_WaitPids.
  166.  *
  167.  * Results:
  168.  *    The return value is the value returned by the vfork system
  169.  *    call (0 means child, > 0 means parent (value is child id),
  170.  *    < 0 means error).
  171.  *
  172.  * Side effects:
  173.  *    A _new process is created, and an entry is added to an internal
  174.  *    table of child processes if the process is created successfully.
  175.  *
  176.  *----------------------------------------------------------------------
  177.  */
  178.  
  179. int
  180. Tcl_Fork()
  181. {
  182. #ifdef macintosh
  183.  
  184.     return -1;
  185.  
  186. #else
  187.  
  188.     WaitInfo *waitPtr;
  189.     pid_t pid;
  190.  
  191.     /*
  192.      * Disable SIGPIPE signals:  if they were allowed, this process
  193.      * might go away unexpectedly if children misbehave.  This code
  194.      * can potentially interfere with other application code that
  195.      * expects to handle SIGPIPEs;  what's really needed is an
  196.      * arbiter for signals to allow them to be "shared".
  197.      */
  198.  
  199.     if (waitTable == NULL) {
  200.     (void) signal(SIGPIPE, SIG_IGN);
  201.     }
  202.  
  203.     /*
  204.      * Enlarge the wait table if there isn't enough space for a _new
  205.      * entry.
  206.      */
  207.  
  208.     if (waitTableUsed == waitTableSize) {
  209.     int newSize;
  210.     WaitInfo *newWaitTable;
  211.  
  212.     newSize = waitTableSize + WAIT_TABLE_GROW_BY;
  213.     newWaitTable = (WaitInfo *) ckalloc((unsigned)
  214.         (newSize * sizeof(WaitInfo)));
  215.     memcpy((VOID *) newWaitTable, (VOID *) waitTable,
  216.         (waitTableSize * sizeof(WaitInfo)));
  217.     if (waitTable != NULL) {
  218.         ckfree((char *) waitTable);
  219.     }
  220.     waitTable = newWaitTable;
  221.     waitTableSize = newSize;
  222.     }
  223.  
  224.     /*
  225.      * Make a _new process and enter it into the table if the fork
  226.      * is successful.
  227.      */
  228.  
  229.     waitPtr = &waitTable[waitTableUsed];
  230.     pid = fork();
  231.     if (pid > 0) {
  232.     waitPtr->pid = pid;
  233.     waitPtr->flags = 0;
  234.     waitTableUsed++;
  235.     }
  236.     return pid;
  237. #endif
  238. }
  239.  
  240. /*
  241.  *----------------------------------------------------------------------
  242.  *
  243.  * Tcl_WaitPids --
  244.  *
  245.  *    This procedure is used to wait for one or more processes created
  246.  *    by Tcl_Fork to exit or suspend.  It records information about
  247.  *    all processes that exit or suspend, even those not waited for,
  248.  *    so that later waits for them will be able to get the status
  249.  *    information.
  250.  *
  251.  * Results:
  252.  *    -1 is returned if there is an error in the wait kernel call.
  253.  *    Otherwise the pid of an exited/suspended process from *pidPtr
  254.  *    is returned and *statusPtr is set to the status value returned
  255.  *    by the wait kernel call.
  256.  *
  257.  * Side effects:
  258.  *    Doesn't return until one of the pids at *pidPtr exits or suspends.
  259.  *
  260.  *----------------------------------------------------------------------
  261.  */
  262.  
  263. int
  264. Tcl_WaitPids(numPids, pidPtr, statusPtr)
  265.     int numPids;        /* Number of pids to wait on:  gives size
  266.                  * of array pointed to by pidPtr. */
  267.     int *pidPtr;        /* Pids to wait on:  return when one of
  268.                  * these processes exits or suspends. */
  269.     int *statusPtr;        /* Wait status is returned here. */
  270. {
  271.  
  272. #ifdef macintosh
  273.  
  274.     return -1;
  275.  
  276. #else
  277.  
  278.     int i, count, pid;
  279.     register WaitInfo *waitPtr;
  280.     int anyProcesses;
  281.     WAIT_STATUS_TYPE status;
  282.  
  283.     while (1) {
  284.     /*
  285.      * Scan the table of child processes to see if one of the
  286.      * specified children has already exited or suspended.  If so,
  287.      * remove it from the table and return its status.
  288.      */
  289.  
  290.     anyProcesses = 0;
  291.     for (waitPtr = waitTable, count = waitTableUsed;
  292.         count > 0; waitPtr++, count--) {
  293.         for (i = 0; i < numPids; i++) {
  294.         if (pidPtr[i] != waitPtr->pid) {
  295.             continue;
  296.         }
  297.         anyProcesses = 1;
  298.         if (waitPtr->flags & WI_READY) {
  299.             *statusPtr = *((int *) &waitPtr->status);
  300.             pid = waitPtr->pid;
  301.             if (WIFEXITED(waitPtr->status)
  302.                 || WIFSIGNALED(waitPtr->status)) {
  303.             *waitPtr = waitTable[waitTableUsed-1];
  304.             waitTableUsed--;
  305.             } else {
  306.             waitPtr->flags &= ~WI_READY;
  307.             }
  308.             return pid;
  309.         }
  310.         }
  311.     }
  312.  
  313.     /*
  314.      * Make sure that the caller at least specified one valid
  315.      * process to wait for.
  316.      */
  317.  
  318.     if (!anyProcesses) {
  319.         errno = ECHILD;
  320.         return -1;
  321.     }
  322.  
  323.     /*
  324.      * Wait for a process to exit or suspend, then update its
  325.      * entry in the table and go back to the beginning of the
  326.      * loop to see if it's one of the desired processes.
  327.      */
  328.  
  329.     pid = wait(&status);
  330.     if (pid < 0) {
  331.         return pid;
  332.     }
  333.     for (waitPtr = waitTable, count = waitTableUsed; ;
  334.         waitPtr++, count--) {
  335.         if (count == 0) {
  336.         break;            /* Ignore unknown processes. */
  337.         }
  338.         if (pid != waitPtr->pid) {
  339.         continue;
  340.         }
  341.  
  342.         /*
  343.          * If the process has been detached, then ignore anything
  344.          * other than an exit, and drop the entry on exit.
  345.          */
  346.  
  347.         if (waitPtr->flags & WI_DETACHED) {
  348.         if (WIFEXITED(status) || WIFSIGNALED(status)) {
  349.             *waitPtr = waitTable[waitTableUsed-1];
  350.             waitTableUsed--;
  351.         }
  352.         } else {
  353.         waitPtr->status = status;
  354.         waitPtr->flags |= WI_READY;
  355.         }
  356.         break;
  357.     }
  358.     }
  359. #endif
  360. }
  361.  
  362. /*
  363.  *----------------------------------------------------------------------
  364.  *
  365.  * Tcl_DetachPids --
  366.  *
  367.  *    This procedure is called to indicate that one or more child
  368.  *    processes have been placed in background and are no longer
  369.  *    cared about.  They should be ignored in future calls to
  370.  *    Tcl_WaitPids.
  371.  *
  372.  * Results:
  373.  *    None.
  374.  *
  375.  * Side effects:
  376.  *    None.
  377.  *
  378.  *----------------------------------------------------------------------
  379.  */
  380.  
  381. void
  382. Tcl_DetachPids(numPids, pidPtr)
  383.     int numPids;        /* Number of pids to detach:  gives size
  384.                  * of array pointed to by pidPtr. */
  385.     int *pidPtr;        /* Array of pids to detach:  must have
  386.                  * been created by Tcl_Fork. */
  387. {
  388. #ifndef macintosh
  389.  
  390.     register WaitInfo *waitPtr;
  391.     int i, count, pid;
  392.  
  393.     for (i = 0; i < numPids; i++) {
  394.     pid = pidPtr[i];
  395.     for (waitPtr = waitTable, count = waitTableUsed;
  396.         count > 0; waitPtr++, count--) {
  397.         if (pid != waitPtr->pid) {
  398.         continue;
  399.         }
  400.  
  401.         /*
  402.          * If the process has already exited then destroy its
  403.          * table entry now.
  404.          */
  405.  
  406.         if ((waitPtr->flags & WI_READY) && (WIFEXITED(waitPtr->status)
  407.             || WIFSIGNALED(waitPtr->status))) {
  408.         *waitPtr = waitTable[waitTableUsed-1];
  409.         waitTableUsed--;
  410.         } else {
  411.         waitPtr->flags |= WI_DETACHED;
  412.         }
  413.         goto nextPid;
  414.     }
  415.     panic("Tcl_Detach couldn't find process");
  416.  
  417.     nextPid:
  418.     continue;
  419.     }
  420. #endif
  421. }
  422.  
  423. /*
  424.  *----------------------------------------------------------------------
  425.  *
  426.  * Tcl_CreatePipeline --
  427.  *
  428.  *    Given an argc/argv array, instantiate a pipeline of processes
  429.  *    as described by the argv.
  430.  *
  431.  * Results:
  432.  *    The return value is a count of the number of _new processes
  433.  *    created, or -1 if an error occurred while creating the pipeline.
  434.  *    *pidArrayPtr is filled in with the address of a dynamically
  435.  *    allocated array giving the ids of all of the processes.  It
  436.  *    is up to the caller to free this array when it isn't needed
  437.  *    anymore.  If inPipePtr is non-NULL, *inPipePtr is filled in
  438.  *    with the file id for the input pipe for the pipeline (if any):
  439.  *    the caller must eventually close this file.  If outPipePtr
  440.  *    isn't NULL, then *outPipePtr is filled in with the file id
  441.  *    for the output pipe from the pipeline:  the caller must close
  442.  *    this file.  If errFilePtr isn't NULL, then *errFilePtr is filled
  443.  *    with a file id that may be used to read error output after the
  444.  *    pipeline completes.
  445.  *
  446.  * Side effects:
  447.  *    Processes and pipes are created.
  448.  *
  449.  *----------------------------------------------------------------------
  450.  */
  451.  
  452. int
  453. Tcl_CreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
  454.     outPipePtr, errFilePtr)
  455.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  456.     int argc;            /* Number of entries in argv. */
  457.     char **argv;        /* Array of strings describing commands in
  458.                  * pipeline plus I/O redirection with <,
  459.                  * <<, and >.  Argv[argc] must be NULL. */
  460.     int **pidArrayPtr;        /* Word at *pidArrayPtr gets filled in with
  461.                  * address of array of pids for processes
  462.                  * in pipeline (first pid is first process
  463.                  * in pipeline). */
  464.     int *inPipePtr;        /* If non-NULL, input to the pipeline comes
  465.                  * from a pipe (unless overridden by
  466.                  * redirection in the command).  The file
  467.                  * id with which to write to this pipe is
  468.                  * stored at *inPipePtr.  -1 means command
  469.                  * specified its own input source. */
  470.     int *outPipePtr;        /* If non-NULL, output to the pipeline goes
  471.                  * to a pipe, unless overriden by redirection
  472.                  * in the command.  The file id with which to
  473.                  * read frome this pipe is stored at
  474.                  * *outPipePtr.  -1 means command specified
  475.                  * its own output sink. */
  476.     int *errFilePtr;        /* If non-NULL, all stderr output from the
  477.                  * pipeline will go to a temporary file
  478.                  * created here, and a descriptor to read
  479.                  * the file will be left at *errFilePtr.
  480.                  * The file will be removed already, so
  481.                  * closing this descriptor will be the end
  482.                  * of the file.  If this is NULL, then
  483.                  * all stderr output goes to our stderr. */
  484. {
  485. #ifdef macintosh
  486.  
  487.     return -1;
  488.  
  489. #else
  490.  
  491.     int *pidPtr = NULL;        /* Points to malloc-ed array holding all
  492.                  * the pids of child processes. */
  493.     int numPids = 0;        /* Actual number of processes that exist
  494.                  * at *pidPtr right now. */
  495.     int cmdCount;        /* Count of number of distinct commands
  496.                  * found in argc/argv. */
  497.     char *input = NULL;        /* Describes input for pipeline, depending
  498.                  * on "inputFile".  NULL means take input
  499.                  * from stdin/pipe. */
  500.     int inputFile = 0;        /* Non-zero means input is name of input
  501.                  * file.  Zero means input holds actual
  502.                  * text to be input to command. */
  503.     char *output = NULL;    /* Holds name of output file to pipe to,
  504.                  * or NULL if output goes to stdout/pipe. */
  505.     int inputId = -1;        /* Readable file id input to current command in
  506.                  * pipeline (could be file or pipe).  -1
  507.                  * means use stdin. */
  508.     int outputId = -1;        /* Writable file id for output from current
  509.                  * command in pipeline (could be file or pipe).
  510.                  * -1 means use stdout. */
  511.     int errorId = -1;        /* Writable file id for all standard error
  512.                  * output from all commands in pipeline.  -1
  513.                  * means use stderr. */
  514.     int lastOutputId = -1;    /* Write file id for output from last command
  515.                  * in pipeline (could be file or pipe).
  516.                  * -1 means use stdout. */
  517.     int pipeIds[2];        /* File ids for pipe that's being created. */
  518.     int firstArg, lastArg;    /* Indexes of first and last arguments in
  519.                  * current command. */
  520.     int lastBar;
  521.     char *execName;
  522.     int i, j, pid;
  523.  
  524.     if (inPipePtr != NULL) {
  525.     *inPipePtr = -1;
  526.     }
  527.     if (outPipePtr != NULL) {
  528.     *outPipePtr = -1;
  529.     }
  530.     if (errFilePtr != NULL) {
  531.     *errFilePtr = -1;
  532.     }
  533.     pipeIds[0] = pipeIds[1] = -1;
  534.  
  535.     /*
  536.      * First, scan through all the arguments to figure out the structure
  537.      * of the pipeline.  Count the number of distinct processes (it's the
  538.      * number of "|" arguments).  If there are "<", "<<", or ">" arguments
  539.      * then make note of input and output redirection and remove these
  540.      * arguments and the arguments that follow them.
  541.      */
  542.  
  543.     cmdCount = 1;
  544.     lastBar = -1;
  545.     for (i = 0; i < argc; i++) {
  546.     if ((argv[i][0] == '|') && ((argv[i][1] == 0))) {
  547.         if ((i == (lastBar+1)) || (i == (argc-1))) {
  548.         interp->result = "illegal use of | in command";
  549.         return -1;
  550.         }
  551.         lastBar = i;
  552.         cmdCount++;
  553.         continue;
  554.     } else if (argv[i][0] == '<') {
  555.         if (argv[i][1] == 0) {
  556.         input = argv[i+1];
  557.         inputFile = 1;
  558.         } else if ((argv[i][1] == '<') && (argv[i][2] == 0)) {
  559.         input = argv[i+1];
  560.         inputFile = 0;
  561.         } else {
  562.         continue;
  563.         }
  564.     } else if ((argv[i][0] == '>') && (argv[i][1] == 0)) {
  565.         output = argv[i+1];
  566.     } else {
  567.         continue;
  568.     }
  569.     if (i >= (argc-1)) {
  570.         Tcl_AppendResult(interp, "can't specify \"", argv[i],
  571.             "\" as last word in command", (char *) NULL);
  572.         return -1;
  573.     }
  574.     for (j = i+2; j < argc; j++) {
  575.         argv[j-2] = argv[j];
  576.     }
  577.     argc -= 2;
  578.     i--;            /* Process _new arg from same position. */
  579.     }
  580.     if (argc == 0) {
  581.     interp->result =  "didn't specify command to execute";
  582.     return -1;
  583.     }
  584.  
  585.     /*
  586.      * Set up the redirected input source for the pipeline, if
  587.      * so requested.
  588.      */
  589.  
  590.     if (input != NULL) {
  591.     if (!inputFile) {
  592.         /*
  593.          * Immediate data in command.  Create temporary file and
  594.          * put data into file.
  595.          */
  596.  
  597. #        define TMP_STDIN_NAME "/tmp/tcl.in.XXXXXX"
  598.         char inName[sizeof(TMP_STDIN_NAME) + 1];
  599.         int length;
  600.  
  601.         strcpy(inName, TMP_STDIN_NAME);
  602.         mktemp(inName);
  603.         inputId = open(inName, O_RDWR|O_CREAT|O_TRUNC, 0600);
  604.         if (inputId < 0) {
  605.         Tcl_AppendResult(interp,
  606.             "couldn't create input file for command: ",
  607.             Tcl_UnixError(interp), (char *) NULL);
  608.         goto error;
  609.         }
  610.         length = strlen(input);
  611.         if (write(inputId, input, length) != length) {
  612.         Tcl_AppendResult(interp,
  613.             "couldn't write file input for command: ",
  614.             Tcl_UnixError(interp), (char *) NULL);
  615.         goto error;
  616.         }
  617.         if ((lseek(inputId, 0L, 0) == -1) || (unlink(inName) == -1)) {
  618.         Tcl_AppendResult(interp,
  619.             "couldn't reset or remove input file for command: ",
  620.             Tcl_UnixError(interp), (char *) NULL);
  621.         goto error;
  622.         }
  623.     } else {
  624.         /*
  625.          * File redirection.  Just open the file.
  626.          */
  627.  
  628.         inputId = open(input, O_RDONLY, 0);
  629.         if (inputId < 0) {
  630.         Tcl_AppendResult(interp,
  631.             "couldn't read file \"", input, "\": ",
  632.             Tcl_UnixError(interp), (char *) NULL);
  633.         goto error;
  634.         }
  635.     }
  636.     } else if (inPipePtr != NULL) {
  637.     if (pipe(pipeIds) != 0) {
  638.         Tcl_AppendResult(interp,
  639.             "couldn't create input pipe for command: ",
  640.             Tcl_UnixError(interp), (char *) NULL);
  641.         goto error;
  642.     }
  643.     inputId = pipeIds[0];
  644.     *inPipePtr = pipeIds[1];
  645.     pipeIds[0] = pipeIds[1] = -1;
  646.     }
  647.  
  648.     /*
  649.      * Set up the redirected output sink for the pipeline from one
  650.      * of two places, if requested.
  651.      */
  652.  
  653.     if (output != NULL) {
  654.     /*
  655.      * Output is to go to a file.
  656.      */
  657.  
  658.     lastOutputId = open(output, O_WRONLY|O_CREAT|O_TRUNC, 0666);
  659.     if (lastOutputId < 0) {
  660.         Tcl_AppendResult(interp,
  661.             "couldn't write file \"", output, "\": ",
  662.             Tcl_UnixError(interp), (char *) NULL);
  663.         goto error;
  664.     }
  665.     } else if (outPipePtr != NULL) {
  666.     /*
  667.      * Output is to go to a pipe.
  668.      */
  669.  
  670.     if (pipe(pipeIds) != 0) {
  671.         Tcl_AppendResult(interp,
  672.             "couldn't create output pipe: ",
  673.             Tcl_UnixError(interp), (char *) NULL);
  674.         goto error;
  675.     }
  676.     lastOutputId = pipeIds[1];
  677.     *outPipePtr = pipeIds[0];
  678.     pipeIds[0] = pipeIds[1] = -1;
  679.     }
  680.  
  681.     /*
  682.      * Set up the standard error output sink for the pipeline, if
  683.      * requested.  Use a temporary file which is opened, then deleted.
  684.      * Could potentially just use pipe, but if it filled up it could
  685.      * cause the pipeline to deadlock:  we'd be waiting for processes
  686.      * to complete before reading stderr, and processes couldn't complete
  687.      * because stderr was backed up.
  688.      */
  689.  
  690.     if (errFilePtr != NULL) {
  691. #    define TMP_STDERR_NAME "/tmp/tcl.err.XXXXXX"
  692.     char errName[sizeof(TMP_STDERR_NAME) + 1];
  693.  
  694.     strcpy(errName, TMP_STDERR_NAME);
  695.     mktemp(errName);
  696.     errorId = open(errName, O_WRONLY|O_CREAT|O_TRUNC, 0600);
  697.     if (errorId < 0) {
  698.         errFileError:
  699.         Tcl_AppendResult(interp,
  700.             "couldn't create error file for command: ",
  701.             Tcl_UnixError(interp), (char *) NULL);
  702.         goto error;
  703.     }
  704.     *errFilePtr = open(errName, O_RDONLY, 0);
  705.     if (*errFilePtr < 0) {
  706.         goto errFileError;
  707.     }
  708.     if (unlink(errName) == -1) {
  709.         Tcl_AppendResult(interp,
  710.             "couldn't remove error file for command: ",
  711.             Tcl_UnixError(interp), (char *) NULL);
  712.         goto error;
  713.     }
  714.     }
  715.  
  716.     /*
  717.      * Scan through the argc array, forking off a process for each
  718.      * group of arguments between "|" arguments.
  719.      */
  720.  
  721.     pidPtr = (int *) ckalloc((unsigned) (cmdCount * sizeof(int)));
  722.     for (i = 0; i < numPids; i++) {
  723.     pidPtr[i] = -1;
  724.     }
  725.     for (firstArg = 0; firstArg < argc; numPids++, firstArg = lastArg+1) {
  726.     for (lastArg = firstArg; lastArg < argc; lastArg++) {
  727.         if ((argv[lastArg][0] == '|') && (argv[lastArg][1] == 0)) {
  728.         break;
  729.         }
  730.     }
  731.     argv[lastArg] = NULL;
  732.     if (lastArg == argc) {
  733.         outputId = lastOutputId;
  734.     } else {
  735.         if (pipe(pipeIds) != 0) {
  736.         Tcl_AppendResult(interp, "couldn't create pipe: ",
  737.             Tcl_UnixError(interp), (char *) NULL);
  738.         goto error;
  739.         }
  740.         outputId = pipeIds[1];
  741.     }
  742.     execName = Tcl_TildeSubst(interp, argv[firstArg]);
  743.     pid = Tcl_Fork();
  744.     if (pid == -1) {
  745.         Tcl_AppendResult(interp, "couldn't fork child process: ",
  746.             Tcl_UnixError(interp), (char *) NULL);
  747.         goto error;
  748.     }
  749.     if (pid == 0) {
  750.         char errSpace[200];
  751.  
  752.         if (((inputId != -1) && (dup2(inputId, 0) == -1))
  753.             || ((outputId != -1) && (dup2(outputId, 1) == -1))
  754.             || ((errorId != -1) && (dup2(errorId, 2) == -1))) {
  755.         char *err;
  756.         err = "forked process couldn't set up input/output\n";
  757.         write(errorId < 0 ? 2 : errorId, err, strlen(err));
  758.         _exit(1);
  759.         }
  760.         for (i = 3; (i <= outputId) || (i <= inputId) || (i <= errorId);
  761.             i++) {
  762.         close(i);
  763.         }
  764.         execvp(execName, &argv[firstArg]);
  765.         sprintf(errSpace, "couldn't find \"%.150s\" to execute\n",
  766.             argv[firstArg]);
  767.         write(2, errSpace, strlen(errSpace));
  768.         _exit(1);
  769.     } else {
  770.         pidPtr[numPids] = pid;
  771.     }
  772.  
  773.     /*
  774.      * Close off our copies of file descriptors that were set up for
  775.      * this child, then set up the input for the next child.
  776.      */
  777.  
  778.     if (inputId != -1) {
  779.         close(inputId);
  780.     }
  781.     if (outputId != -1) {
  782.         close(outputId);
  783.     }
  784.     inputId = pipeIds[0];
  785.     pipeIds[0] = pipeIds[1] = -1;
  786.     }
  787.     *pidArrayPtr = pidPtr;
  788.  
  789.     /*
  790.      * All done.  Cleanup open files lying around and then return.
  791.      */
  792.  
  793. cleanup:
  794.     if (inputId != -1) {
  795.     close(inputId);
  796.     }
  797.     if (lastOutputId != -1) {
  798.     close(lastOutputId);
  799.     }
  800.     if (errorId != -1) {
  801.     close(errorId);
  802.     }
  803.     return numPids;
  804.  
  805.     /*
  806.      * An error occurred.  There could have been extra files open, such
  807.      * as pipes between children.  Clean them all up.  Detach any child
  808.      * processes that have been created.
  809.      */
  810.  
  811.     error:
  812.     if ((inPipePtr != NULL) && (*inPipePtr != -1)) {
  813.     close(*inPipePtr);
  814.     *inPipePtr = -1;
  815.     }
  816.     if ((outPipePtr != NULL) && (*outPipePtr != -1)) {
  817.     close(*outPipePtr);
  818.     *outPipePtr = -1;
  819.     }
  820.     if ((errFilePtr != NULL) && (*errFilePtr != -1)) {
  821.     close(*errFilePtr);
  822.     *errFilePtr = -1;
  823.     }
  824.     if (pipeIds[0] != -1) {
  825.     close(pipeIds[0]);
  826.     }
  827.     if (pipeIds[1] != -1) {
  828.     close(pipeIds[1]);
  829.     }
  830.     if (pidPtr != NULL) {
  831.     for (i = 0; i < numPids; i++) {
  832.         if (pidPtr[i] != -1) {
  833.         Tcl_DetachPids(1, &pidPtr[i]);
  834.         }
  835.     }
  836.     ckfree((char *) pidPtr);
  837.     }
  838.     numPids = -1;
  839.     goto cleanup;
  840. #endif
  841. }
  842.  
  843. /*
  844.  *----------------------------------------------------------------------
  845.  *
  846.  * Tcl_UnixError --
  847.  *
  848.  *    This procedure is typically called after UNIX kernel calls
  849.  *    return errors.  It stores machine-readable information about
  850.  *    the error in $errorCode returns an information string for
  851.  *    the caller's use.
  852.  *
  853.  * Results:
  854.  *    The return value is a human-readable string describing the
  855.  *    error, as returned by strerror.
  856.  *
  857.  * Side effects:
  858.  *    The global variable $errorCode is reset.
  859.  *
  860.  *----------------------------------------------------------------------
  861.  */
  862.  
  863. char *
  864. Tcl_UnixError(interp)
  865.     Tcl_Interp *interp;        /* Interpreter whose $errorCode variable
  866.                  * is to be changed. */
  867. {
  868.     char *id, *msg;
  869.  
  870.     id = Tcl_ErrnoId();
  871.     msg = strerror(errno);
  872.     Tcl_SetErrorCode(interp, "UNIX", id, msg, (char *) NULL);
  873.     return msg;
  874. }
  875.  
  876.  
  877. /*
  878.  *----------------------------------------------------------------------
  879.  *
  880.  * TclMakeFileTable --
  881.  *
  882.  *    Create or enlarge the file table for the interpreter, so that
  883.  *    there is room for a given index.
  884.  *
  885.  * Results:
  886.  *    None.
  887.  *
  888.  * Side effects:
  889.  *    The file table for iPtr will be created if it doesn't exist
  890.  *    (and entries will be added for stdin, stdout, and stderr).
  891.  *    If it already exists, then it will be grown if necessary.
  892.  *
  893.  *----------------------------------------------------------------------
  894.  */
  895.  
  896. void
  897. TclMakeFileTable(iPtr, index)
  898.     Interp *iPtr;        /* Interpreter whose table of files is
  899.                  * to be manipulated. */
  900.     int index;            /* Make sure table is large enough to
  901.                  * hold at least this index. */
  902. {
  903.     /*
  904.      * If the table doesn't even exist, then create it and initialize
  905.      * entries for standard files.
  906.      */
  907.  
  908.     if (iPtr->numFiles == 0) {
  909.     OpenFile *filePtr;
  910.     int i;
  911.  
  912.     if (index < 2) {
  913.         iPtr->numFiles = 3;
  914.     } else {
  915.         iPtr->numFiles = index+1;
  916.     }
  917.     iPtr->filePtrArray = (OpenFile **) ckalloc((unsigned)
  918.         ((iPtr->numFiles)*sizeof(OpenFile *)));
  919.     for (i = iPtr->numFiles-1; i >= 0; i--) {
  920.         iPtr->filePtrArray[i] = NULL;
  921.     }
  922.  
  923.     filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  924.     filePtr->f = stdin;
  925.     filePtr->f2 = NULL;
  926.     filePtr->readable = 1;
  927.     filePtr->writable = 0;
  928.     filePtr->numPids = 0;
  929.     filePtr->pidPtr = NULL;
  930.     filePtr->errorId = -1;
  931.     iPtr->filePtrArray[0] = filePtr;
  932.  
  933.     filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  934.     filePtr->f = stdout;
  935.     filePtr->f2 = NULL;
  936.     filePtr->readable = 0;
  937.     filePtr->writable = 1;
  938.     filePtr->numPids = 0;
  939.     filePtr->pidPtr = NULL;
  940.     filePtr->errorId = -1;
  941.     iPtr->filePtrArray[1] = filePtr;
  942.  
  943.     filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  944.     filePtr->f = stderr;
  945.     filePtr->f2 = NULL;
  946.     filePtr->readable = 0;
  947.     filePtr->writable = 1;
  948.     filePtr->numPids = 0;
  949.     filePtr->pidPtr = NULL;
  950.     filePtr->errorId = -1;
  951.     iPtr->filePtrArray[2] = filePtr;
  952.     } else if (index >= iPtr->numFiles) {
  953.     int newSize;
  954.     OpenFile **newPtrArray;
  955.     int i;
  956.  
  957.     newSize = index+1;
  958.     newPtrArray = (OpenFile **) ckalloc((unsigned)
  959.         ((newSize)*sizeof(OpenFile *)));
  960.     memcpy((VOID *) newPtrArray, (VOID *) iPtr->filePtrArray,
  961.         iPtr->numFiles*sizeof(OpenFile *));
  962.     for (i = iPtr->numFiles; i < newSize; i++) {
  963.         newPtrArray[i] = NULL;
  964.     }
  965.     ckfree((char *) iPtr->filePtrArray);
  966.     iPtr->numFiles = newSize;
  967.     iPtr->filePtrArray = newPtrArray;
  968.     }
  969. }
  970.  
  971. /*
  972.  *----------------------------------------------------------------------
  973.  *
  974.  * TclGetOpenFile --
  975.  *
  976.  *    Given a string identifier for an open file, find the corresponding
  977.  *    open file structure, if there is one.
  978.  *
  979.  * Results:
  980.  *    A standard Tcl return value.  If the open file is successfully
  981.  *    located, *filePtrPtr is modified to point to its structure.
  982.  *    If TCL_ERROR is returned then interp->result contains an error
  983.  *    message.
  984.  *
  985.  * Side effects:
  986.  *    None.
  987.  *
  988.  *----------------------------------------------------------------------
  989.  */
  990.  
  991. int
  992. TclGetOpenFile(interp, string, filePtrPtr)
  993.     Tcl_Interp *interp;        /* Interpreter in which to find file. */
  994.     char *string;        /* String that identifies file. */
  995.     OpenFile **filePtrPtr;    /* Address of word in which to store pointer
  996.                  * to structure about open file. */
  997. {
  998.     int fd = 0;            /* Initial value needed only to stop compiler
  999.                  * warnings. */
  1000.     Interp *iPtr = (Interp *) interp;
  1001.  
  1002.     if ((string[0] == 'f') && (string[1] == 'i') && (string[2] == 'l')
  1003.         & (string[3] == 'e')) {
  1004.     char *end;
  1005.  
  1006.     fd = strtoul(string+4, &end, 10);
  1007.     if ((end == string+4) || (*end != 0)) {
  1008.         goto badId;
  1009.     }
  1010.     } else if ((string[0] == 's') && (string[1] == 't')
  1011.         && (string[2] == 'd')) {
  1012.     if (strcmp(string+3, "in") == 0) {
  1013.         fd = 0;
  1014.     } else if (strcmp(string+3, "out") == 0) {
  1015.         fd = 1;
  1016.     } else if (strcmp(string+3, "err") == 0) {
  1017.         fd = 2;
  1018.     } else {
  1019.         goto badId;
  1020.     }
  1021.     } else {
  1022.     badId:
  1023.     Tcl_AppendResult(interp, "bad file identifier \"", string,
  1024.         "\"", (char *) NULL);
  1025.     return TCL_ERROR;
  1026.     }
  1027.  
  1028.     if (fd >= iPtr->numFiles) {
  1029.     if ((iPtr->numFiles == 0) && (fd <= 2)) {
  1030.         TclMakeFileTable(iPtr, fd);
  1031.     } else {
  1032.         notOpen:
  1033.         Tcl_AppendResult(interp, "file \"", string, "\" isn't open",
  1034.             (char *) NULL);
  1035.         return TCL_ERROR;
  1036.     }
  1037.     }
  1038.     if (iPtr->filePtrArray[fd] == NULL) {
  1039.     goto notOpen;
  1040.     }
  1041.     *filePtrPtr = iPtr->filePtrArray[fd];
  1042.     return TCL_OK;
  1043. }
  1044.